home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROCS.ZIP / LSCAN.ICN < prev    next >
Text File  |  1992-09-28  |  15KB  |  547 lines

  1. ############################################################################
  2. #
  3. #    File:     lscan.icn
  4. #
  5. #    Subject:  Procedures for quasi scanning routines for lists
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     June 3, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.20
  14. #
  15. ###########################################################################
  16. #
  17. #  Purpose: String scanning is terrific, but often I am forced to
  18. #  tokenize and work with lists.  So as to make operations on these
  19. #  lists as close to corresponding string operations as possible, I've
  20. #  implemented a series of list analogues to any(), bal(), find(),
  21. #  many(), match(), move(), pos(), tab(), and upto().  Their names are
  22. #  just like corresponding string functions, except with a prepended
  23. #  "l_" (e.g. l_any()).  Functionally, the list routines parallel the
  24. #  string ones closely, except that in place of strings, l_find and
  25. #  l_match accept lists as their first argument.  L_any(), l_many(),
  26. #  and l_upto() all take either sets of lists or lists of lists (e.g.
  27. #  l_tab(l_upto([["a"],["b"],["j","u","n","k"]])).  Note that l_bal(),
  28. #  unlike the builtin bal(), has no defaults for the first four
  29. #  arguments.  This just seemed appropriate, given that no precise
  30. #  list analogue to &cset, etc. occurs.
  31. #
  32. #  The default subject for list scans (analogous to &subject) is
  33. #  l_SUBJ.  The equivalent of &pos is l_POS.  Naturally, these
  34. #  variables are both global.  They are used pretty much like &subject
  35. #  and &pos, except that they are null until a list scanning
  36. #  expression has been encountered containing a call to l_Bscan() (on
  37. #  which, see below).
  38. #
  39. #  Note that environments cannot be maintained quite as elegantly as
  40. #  they can be for the builtin string-scanning functions.  One must
  41. #  use instead a set of nested procedure calls, as explained in the
  42. #  _Icon Analyst_ 1:6 (June, 1991), p. 1-2.  In particular, one cannot
  43. #  suspend, return, or otherwise break out of the nested procedure
  44. #  calls.  They can only be exited via failure.  The names of these
  45. #  procedures, at least in this implementation, are l_Escan and
  46. #  l_Bscan.  Here is one example of how they might be invoked:
  47. #
  48. #      suspend l_Escan(l_Bscan(some_list_or_other), {
  49. #          l_tab(10 to *l_SUBJ) & {
  50. #              if l_any(l1) | l_match(l2) then
  51. #                  old_l_POS + (l_POS-1)
  52. #          }
  53. #      })
  54. #
  55. #  Note that you cannot do this:
  56. #
  57. #      l_Escan(l_Bscan(some_list_or_other), {
  58. #          l_tab(10 to *l_SUBJ) & {
  59. #              if l_any(l1) | l_match(l2) then
  60. #                  suspend old_l_POS + (l_POS-1)
  61. #          }
  62. #      })
  63. #
  64. #  Remember, it's no fair to use suspend within the list scanning
  65. #  expression.  l_Escan must do all the suspending.  It is perfectly OK,
  66. #  though, to nest well-behaved list scanning expressions.  And they can
  67. #  be reliably used to generate a series of results as well.
  68. #
  69. ############################################################################
  70. #
  71. #  Here's another simple example of how one might invoke the l_scan
  72. #  routines:
  73. #
  74. #  procedure main()
  75. #
  76. #      l := ["h","e","l","l","o"," ","t","t","t","h","e","r","e"]
  77. #
  78. #      l_Escan(l_Bscan(l), {
  79. #          hello_list := l_tab(l_match(["h","e","l","l","o"]))
  80. #          every writes(!hello_list)
  81. #          write()
  82. #
  83. #          # Note the nested list-scanning expressions.
  84. #       l_Escan(l_Bscan(l_tab(0)), {
  85. #           l_tab(l_many([[" "],["t"]]) - 1)
  86. #              every writes(!l_tab(0))
  87. #           write()
  88. #          })
  89. #      })
  90. #  
  91. #  end
  92. #
  93. #  The above program simply writes "hello" and "there" on successive
  94. #  lines to the standard output.
  95. #
  96. ############################################################################
  97. #
  98. #  PITFALLS: In general, note that we are comparing lists here instead
  99. #  of strings, so l_find("h", l), for instance, will yield an error
  100. #  message (use l_find(["h"], l) instead).  The point at which I
  101. #  expect this nuance will be most confusing will be in cases where
  102. #  one is looking for lists within lists.  Suppose we have a list,
  103. #
  104. #      l1 := ["junk",[["hello"]," ",["there"]],"!","m","o","r","e","junk"]
  105. #
  106. #  and suppose, moreover, that we wish to find the position in l1 at
  107. #  which the list
  108. #
  109. #      [["hello"]," ",["there"]]
  110. #
  111. #  occurs.  If, say, we assign [["hello"]," ",["there"]] to the
  112. #  variable l2, then our l_find() expression will need to look like
  113. #
  114. #      l_find([l2],l1)
  115. #
  116. ############################################################################
  117. #
  118. #  Extending scanning to lists is really very difficult.  What I think
  119. #  (at least tonight) is that scanning should never have been
  120. #  restricted to strings.  It should have been designed to operate on
  121. #  all homogenous one-dimensional arrays (vectors, for you LISPers).
  122. #  You should be able, in other words, to scan vectors of ints, longs,
  123. #  characters - any data type that seems useful.  The only question in
  124. #  my mind is how to represent vectors as literals.  Extending strings
  125. #  to lists goes beyond the bounds of scanning per-se.  This library is
  126. #  therefore something of a stab in the dark.
  127. #
  128. ############################################################################
  129.  
  130.  
  131. global l_POS
  132. global l_SUBJ
  133. record l_ScanEnvir(subject,pos)
  134.  
  135. procedure l_Bscan(e1)
  136.  
  137.     #
  138.     # Prototype list scan initializer.  Based on code published in
  139.     # the _Icon Analyst_ 1:6 (June, 1991), p. 1-2.
  140.     #
  141.     local l_OuterEnvir
  142.     initial {
  143.     l_SUBJ := []
  144.     l_POS := 1
  145.     }
  146.  
  147.     #
  148.     # Save outer scanning environment.
  149.     #
  150.     l_OuterEnvir := l_ScanEnvir(l_SUBJ, l_POS)
  151.  
  152.     #
  153.     # Set current scanning environment to subject e1 (arg 1).  Pos
  154.     # defaults to 1.  Suspend the saved environment.  Later on, the
  155.     # l_Escan procedure will need this in case the scanning expres-
  156.     # sion as a whole sends a result back to the outer environment,
  157.     # and the outer environment changes l_SUBJ and l_POS.
  158.     #
  159.     l_SUBJ := e1
  160.     l_POS  := 1
  161.     suspend l_OuterEnvir
  162.  
  163.     #
  164.     # Restore the saved environment (plus any changes that might have
  165.     # been made to it as noted in the previous run of comments).
  166.     #
  167.     l_SUBJ := l_OuterEnvir.subject
  168.     l_POS := l_OuterEnvir.pos
  169.  
  170.     #
  171.     # Signal failure of the scanning expression (we're done producing
  172.     # results if we get to here).
  173.     #
  174.     fail
  175.  
  176. end
  177.  
  178.  
  179.  
  180. procedure l_Escan(l_OuterEnvir, e2)
  181.  
  182.     local l_InnerEnvir
  183.  
  184.     #
  185.     # Set the inner scanning environment to the values assigned to it
  186.     # by l_Bscan.  Remember that l_SUBJ and l_POS are global.  They
  187.     # don't need to be passed as parameters from l_Bscan.  What
  188.     # l_Bscan() needs to pass on is the l_OuterEnvir record,
  189.     # containing the values of l_SUBJ and l_POS before l_Bscan() was
  190.     # called.  l_Escan receives this "outer environment" as its first
  191.     # argument, l_OuterEnvir.
  192.     #
  193.     l_InnerEnvir := l_ScanEnvir(l_SUBJ, l_POS)
  194.  
  195.     #
  196.     # Whatever expression produced e2 has passed us a result.  Now we
  197.     # restore l_SUBJ and l_POS, and send that result back to the outer
  198.     # environment.
  199.     #
  200.     l_SUBJ := l_OuterEnvir.subject
  201.     l_POS := l_OuterEnvir.pos
  202.     suspend e2
  203.  
  204.     #
  205.     # Okay, we've resumed to (attempt to) produce another result.  Re-
  206.     # store the inner scanning environment (the one we're using in the
  207.     # current scanning expression).  Remember?  It was saved in l_Inner-
  208.     # Envir just above.
  209.     #
  210.     l_SUBJ := l_InnerEnvir.subject
  211.     l_POS := l_InnerEnvir.pos
  212.  
  213.     #
  214.     # Fail so that the second argument (the one that produced e2) gets
  215.     # resumed.  If it fails to produce another result, then the first
  216.     # argument is resumed, which is l_Bscan().  If l_Bscan is resumed, it
  217.     # will restore the outer environment and fail, causing the entire
  218.     # scanning expression to fail.
  219.     #
  220.     fail
  221.  
  222. end
  223.  
  224.     
  225.  
  226. procedure l_move(i)
  227.  
  228.     /i & stop("l_move:  Null argument.")
  229.     if /l_POS | /l_SUBJ then
  230.     stop("l_move:  Call l_Bscan() first.")
  231.  
  232.     #
  233.     # Sets l_POS to l_POS+i; suspends that portion of l_SUBJ extending
  234.     # from the old l_POS to the new one.  Resets l_POS if resumed,
  235.     # just the way matching procedures are supposed to.  Fails if l_POS
  236.     # plus i is larger than l_SUBJ+1 or if l_POS+i is less than 1.
  237.     #
  238.     suspend l_SUBJ[.l_POS:l_POS <- (0 < (*l_SUBJ+1 >= l_POS+i))]
  239.  
  240. end
  241.  
  242.  
  243.  
  244. procedure l_tab(i)
  245.  
  246.     /i & stop("l_tab:  Null argument.")
  247.     if /l_POS | /l_SUBJ then
  248.     stop("l_tab:  Call l_Bscan() first.")
  249.  
  250.     if i <= 0
  251.     then suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i)]
  252.     else suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= i)]
  253.  
  254. end
  255.  
  256.  
  257.  
  258. procedure l_any(l1,l2,i,j)
  259.  
  260.     #
  261.     # Like any(c,s2,i,j) except that the string & cset arguments are
  262.     # replaced by list arguments.  l1 must be a list of one-element
  263.     # lists, while l2 can be any list (l_SUBJ by default).
  264.     #
  265.  
  266.     local sub_l, x
  267.  
  268.     /l1 & stop("l_any:  Null first argument!")
  269.     if type(l1) == "set" then l1 := sort(l1)
  270.  
  271.     /l2 := l_SUBJ
  272.     if \i then {
  273.     if i < 1 then
  274.         i := *l2 + (i+1)
  275.     }
  276.     else i := \l_POS | 1
  277.     if \j then {
  278.     if j < 1 then
  279.         j := *l2 + (j+1)
  280.     }
  281.     else j := *l_SUBJ+1
  282.  
  283.     (i+1) > j & i :=: j
  284.     every sub_l := !l1 do {
  285.     if not (type(sub_l) == "list", *sub_l = 1) then
  286.         stop("l_any:  Elements of l1 must be lists of length 1.")
  287.     # Let l_match check to see if i+1 is out of range.
  288.     if x := l_match(sub_l,l2,i,i+1) then
  289.         return x
  290.     }
  291.     
  292. end
  293.  
  294.  
  295.  
  296. procedure l_match(l1,l2,i,j)
  297.  
  298.     #
  299.     # Analogous to match(s1,s2,i,j), except that s1 and s2 are lists,
  300.     # and l_match returns the next position in l2 after that portion
  301.     # (if any) which is structurally identical to l1.  If a match is not
  302.     # found, l_match fails.
  303.     #
  304.  
  305.     if /l1
  306.     then stop("l_match:  Null first argument!")
  307.     if type(l1) ~== "list"
  308.     then stop("l_match:  Call me with a list as the first arg.")
  309.  
  310.     /l2 := l_SUBJ
  311.     if \i then {
  312.     if i < 1 then
  313.         i := *l2 + (i+1)
  314.     }
  315.     else i := \l_POS | 1
  316.     
  317.     if \j then {
  318.     if j < 1 then
  319.         j := *l2 + (j+1)
  320.     }
  321.     else j := *l_SUBJ+1
  322.  
  323.     i + *l1 > j & i :=: j
  324.     i + *l1 > j & fail
  325.     if l_comp(l1,l2[i+:*l1]) then
  326.     return i + *l1
  327.  
  328. end
  329.  
  330.     
  331.  
  332. procedure l_comp(l1,l2)
  333.  
  334.     #
  335.     # List comparison routine basically taken from Griswold & Griswold
  336.     # (1st ed.), p. 174.
  337.     #
  338.  
  339.     local i
  340.  
  341.     /l1 | /l2 & stop("l_comp:  Null argument!")
  342.     l1 === l2 & (return l2)
  343.  
  344.     if type(l1) == type(l2) == "list" then {
  345.     *l1 ~= *l2 & fail
  346.     every i := 1 to *l1
  347.     do l_comp(l1[i],l2[i]) | fail
  348.     return l2
  349.     }
  350.  
  351. end
  352.  
  353.  
  354.  
  355. procedure l_find(l1,l2,i,j)
  356.  
  357.     #
  358.     # Like the builtin find(s1,s2,i,j), but for lists.
  359.     #
  360.  
  361.     local x, old_l_POS
  362.  
  363.     /l1 & stop("l_find:  Null first argument!")
  364.  
  365.     /l2 := l_SUBJ
  366.     if \i then {
  367.     if i < 1 then
  368.         i := *l2 + (i+1)
  369.     }
  370.     else i := \l_POS | 1
  371.     if \j then {
  372.     if j < 1 then
  373.         j := *l2 + (j+1)
  374.     }
  375.     else j := *l_SUBJ+1
  376.  
  377.     #
  378.     # See l_upto() below for a discussion of why things have to be done
  379.     # in this manner.
  380.     #
  381.     old_l_POS := l_POS
  382.  
  383.     suspend l_Escan(l_Bscan(l2[i:j]), {
  384.     l_tab(1 to *l_SUBJ) & {
  385.         if l_match(l1) then
  386.         old_l_POS + (l_POS-1)
  387.     }
  388.     })
  389.     
  390. end
  391.  
  392.  
  393.  
  394. procedure l_upto(l1,l2,i,j)
  395.  
  396.     #
  397.     # See l_any() above.  This procedure just moves through l2, calling
  398.     # l_any() for each member of l2[i:j].
  399.     #
  400.  
  401.     local old_l_POS
  402.  
  403.     /l1 & stop("l_upto:  Null first argument!")
  404.     if type(l1) == "set" then l1 := sort(l1)
  405.  
  406.     /l2 := l_SUBJ
  407.     if \i then {
  408.     if i < 1 then
  409.         i := *l2 + (i+1)
  410.     }
  411.     else i := \l_POS | 1
  412.     if \j then {
  413.     if j < 1 then
  414.         j := *l2 + (j+1)
  415.     }
  416.     else j := *l_SUBJ+1
  417.  
  418.     #
  419.     # Save the old pos, then try arb()ing through the list to see if we
  420.     # can do an l_any(l1) at any position.
  421.     #
  422.     old_l_POS := l_POS
  423.  
  424.     suspend l_Escan(l_Bscan(l2[i:j]), {
  425.     l_tab(1 to *l_SUBJ) & {
  426.         if l_any(l1) then
  427.         old_l_POS + (l_POS-1)
  428.     }
  429.     })
  430.  
  431.     #
  432.     # Note that it WILL NOT WORK if you say:
  433.     #
  434.     # l_Escan(l_Bscan(l2[i:j]), {
  435.     #     l_tab(1 to *l_SUBJ) & {
  436.     #         if l_any(l1) then
  437.     #             suspend old_l_POS + (l_POS-1)
  438.     #     }
  439.     # })
  440.     #
  441.     # If we are to suspend a result, l_Escan must suspend that result.
  442.     # Otherwise scanning environments are not saved and/or restored
  443.     # properly.
  444.     #
  445.     
  446. end
  447.  
  448.  
  449.  
  450. procedure l_many(l1,l2,i,j)
  451.  
  452.     local x, old_l_POS
  453.  
  454.     /l1 & stop("l_many:  Null first argument!")
  455.     if type(l1) == "set" then l1 := sort(l1)
  456.  
  457.     /l2 := l_SUBJ
  458.     if \i then {
  459.     if i < 1 then
  460.         i := *l2 + (i+1)
  461.     }
  462.     else i := \l_POS | 1
  463.     if \j then {
  464.     if j < 1 then
  465.         j := *l2 + (j+1)
  466.     }
  467.     else j := *l_SUBJ+1
  468.  
  469.     #
  470.     # L_many(), like many(), is not a generator.  We can therefore
  471.     # save one final result in x, and then later return (rather than
  472.     # suspend) that result.
  473.     #
  474.     old_l_POS := l_POS
  475.     l_Escan(l_Bscan(l2[i:j]), {
  476.     while l_tab(l_any(l1))
  477.     x := old_l_POS + (l_POS-1)
  478.     })
  479.  
  480.     #
  481.     # Fails if there was no positional change (i.e. l_any() did not
  482.     # succeed even once).
  483.     #
  484.     return old_l_POS ~= x
  485.  
  486. end
  487.  
  488.  
  489.  
  490. procedure l_pos(i)
  491.  
  492.     local x
  493.  
  494.     if /l_POS | /l_SUBJ
  495.     then stop("l_move:  Call l_Bscan() first.")
  496.  
  497.     if i <= 0
  498.     then x := 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i) | fail
  499.     else x := 0 < (*l_SUBJ+1 >= i) | fail
  500.  
  501.     if x = l_POS
  502.     then return x
  503.     else fail
  504.  
  505. end
  506.  
  507.  
  508.  
  509. procedure l_bal(l1,l2,l3,l,i,j)
  510.  
  511.     local l2_count, l3_count, x, position
  512.  
  513.     /l1 & stop("l_bal:  Null first argument!")
  514.     if type(l1) == "set" then l1 := sort(l1)  # convert to a list
  515.     if type(l2) == "set" then l1 := sort(l2)
  516.     if type(l3) == "set" then l1 := sort(l3)
  517.  
  518.     /l2 := l_SUBJ
  519.     if \i then {
  520.     if i < 1 then
  521.         i := *l2 + (i+1)
  522.     }
  523.     else i := \l_POS | 1
  524.     if \j then {
  525.     if j < 1 then
  526.         j := *l2 + (j+1)
  527.     }
  528.     else j := *l_SUBJ+1
  529.  
  530.     l2_count := l3_count := 0
  531.  
  532.     every x := i to j-1 do {
  533.  
  534.     if l_any(l2, l, x, x+1) then {
  535.         l2_count +:= 1
  536.     }
  537.     if l_any(l3, l, x, x+1) then {
  538.         l3_count +:= 1
  539.     }
  540.     if l2_count = l3_count then {
  541.         if l_any(l1,l,x,x+1)
  542.         then suspend x
  543.     }
  544.     }
  545.  
  546. end
  547.